      SUBROUTINE SETUP
      INCLUDE 'BLOCO.INC'
      EPSX=1.D-14
      SCFMAX=1.D6
      RHO=1.D-8
      RHO1=1.D-8
      RETURN
      END
C   HS54 IN THE ORIGINAL SCALING
      BLOCK DATA
      INCLUDE 'BLOCO.INC'
      INTEGER I,J
      DATA NAME/'HS54ORIG'/
      DATA (X(I),I=1,6)/6.D3,1.5D0,4.D6,2.D0,3.D-3,5.D7/
      DATA N/6/ , NH/1/ , NG/12/
      DATA DEL0/1.00D-4/ ,TAU0/1.00D0/ ,TAU/.1D0/
      DATA (GUNIT(1,J),J=2,13)/12*1/,(GUNIT(3,I),I=2,13)/6*1,6*-1/,
     F     (GUNIT(2,I),I=2,13)/1,2,3,4,5,6,
     F     1,2,3,4,5,6/
     F     ,((GUNIT(I,J),I=1,3),J=0,1)/-1,0,0,-1,0,0/
      END
      SUBROUTINE EF(X,FX)
      INCLUDE 'FUCO.INC'
      DOUBLE PRECISION X(NX),FX,Y1,Y2,Y3,Y4,Y5,Y6
      ICF=ICF+1
      Y1=X(1)
      Y2=X(2)
      Y3=X(3)
      Y4=X(4)
      Y5=X(5)
      Y6=X(6)
      ICF=ICF+1
      FX=-DEXP(-(((Y1-1.D4)**2/6.4D7+(Y1-1.D4)*(Y2-1.D0)/2.D4
     F    +6.25D0*(Y2-1.D0)**2)/.96D0+(Y3-2.D6)**2
     F   /49.D12+(Y4-1.D1)**2/2.5D3+(Y5-1.D-3)**2/2.5D-3
     F    +(Y6-1.D8)**2/2.5D17)*.5D0)
      RETURN
      END
      SUBROUTINE EGRADF(X,GRADF)
      INCLUDE 'FUCO.INC'
      DOUBLE PRECISION X(NX),GRADF(NX),Y1,Y2,Y3,Y4,Y5,Y6,TERM
      ICGF=ICGF+1
      Y1=X(1)
      Y2=X(2)
      Y3=X(3)
      Y4=X(4)
      Y5=X(5)
      Y6=X(6)
      TERM=DEXP(-(((Y1-1.D4)**2/6.4D7+(Y1-1.D4)*(Y2-1.D0)/2.D4
     F    +6.25D0*(Y2-1.D0)**2)/.96D0+(Y3-2.D6)**2
     F   /49.D12+(Y4-1.D1)**2/2.5D3+(Y5-1.D-3)**2/2.5D-3
     F    +(Y6-1.D8)**2/2.5D17)*.5D0)*.5D0
      ICGF=ICGF+1
      GRADF(1)= TERM*((2.D0*(Y1-1.D4)/6.4D7+(Y2-1.D0)/2.D4)/.96D0)
      GRADF(2)= TERM*((Y1-1.D4)/2.D4+1.25D1*(Y2-1.D0))/.96D0
      GRADF(3)= TERM*(Y3-2.D6)/24.5D12
      GRADF(4)= TERM*2.D0*(Y4-1.D1)/2.5D3
      GRADF(5)= TERM*2.D0*(Y5-1.D-3)/2.5D-3
      GRADF(6)= TERM*2.D0*(Y6-1.D8)/2.5D17
      RETURN
      END
      SUBROUTINE EH(I,X,HXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),HXI
      CRES(I)=CRES(I)+1
      HXI=X(1)+4.D3*X(2)-1.76D4
      RETURN
      END
      SUBROUTINE EGRADH(I,X,GRADHI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX),GRADHI(NX),H(6)
      SAVE H
      DATA H/1.D0,4.D3,4*0.D0/
      CGRES(I)=CGRES(I)+1
      DO      100      J=1,N
      GRADHI(J)=H(J)
  100 CONTINUE
      RETURN
      END
      SUBROUTINE EG(I,X,GXI)
      INCLUDE 'FUCO.INC'
      INTEGER I
      DOUBLE PRECISION X(NX),OG(6),UG(6),GXI
      SAVE UG,OG
      DATA OG/2.D4,1.D1,1.D7,2.D1,1.D0,2.D8/
      DATA UG/0.D0,-10.0D0,0.D0,0.D0,-1.D0,0.D0/
      IF ( GUNIT(1,I+NH) .EQ. -1 ) CRES(I+NH)=CRES(I+NH)+1
      IF(I.GT.6)      GOTO 100
      GXI=X(I)-UG(I)
      RETURN
  100 CONTINUE
      GXI=OG(I-6)-X(I-6)
      END
      SUBROUTINE EGRADG(I,X,GRADGI)
      INCLUDE 'FUCO.INC'
      INTEGER I,J
      DOUBLE PRECISION X(NX) ,GRADGI(NX)
      DO      100      J=1,6
      GRADGI(J)=0.D0
  100 CONTINUE
       IF(I.LE.6)     GRADGI(I)=1.D0
       IF(I.GT.6)     GRADGI(I-6)=-1.D0
      RETURN
      END


